home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / ai.prl / mike1.exe / IO.PL < prev    next >
Encoding:
Text File  |  1990-09-03  |  7.2 KB  |  198 lines
  1. /* file: IO.PL  {query, how, and why} */
  2. /*                          *************
  3.                                M I K E
  4.                             *************
  5.                Micro Interpreter for Knowledge Engineering
  6.                   {written in Edinburgh-syntax Prolog}
  7.  
  8. MIKE: Copyright (c) 1989, 1990 The Open University (U.K.)
  9.  
  10. MIKE is intended for educational purposes, and may not
  11. be sold as or incorporated in a commercial product without
  12. written permission from: The Copyrights Officer, Open University,
  13. Milton Keynes MK7 6AA, U.K.
  14.  
  15. The Open University accepts no responsibility for any legal or other
  16. consequences which may arise directly or indirectly as a result of the
  17. use of all or parts of the contents of this program.
  18.  
  19. This software accompanies Open University Study Pack PD624, 'KNOWLEDGE
  20. ENGINEERING'.  Complete sets of study pack materials may be obtained from:
  21.  
  22.                       Learning Materials Sales Office
  23.                       The Open University
  24.                       P.O. Box 188
  25.                       Milton Keynes MK7 6DH, U.K.
  26.  
  27.                       Tel: [+44] (908) 653338
  28.                       Fax: [+44] (908) 653744
  29. */
  30. /* This file handles Input/output from/to user via query, how, and why */
  31.  
  32. query Q receives_answer yes :-
  33.   Q receives_answer no,!,fail.
  34. query Q receives_answer no :-
  35.   Q receives_answer yes,!,fail.
  36.  
  37. query Question receives_answer Answer :-
  38.     Question receives_answer Answer,!.  /* don't ask same question twice*/
  39. query the A of B receives_answer Answer :-
  40.     the A of B is Answer receives_answer yes.
  41.  
  42. /* it is an implicit assumption that the answer is either yes or no */
  43. query the Attr of Obj is Value receives_answer Answer:-
  44.     var(Value),
  45.     'pd624 write'(['Error: the Value facet must be bound in a question',nl,
  46.         'of the form "the attribute of object is value".  If you ',nl,
  47.         'actually want to find out the value then you must use the',
  48.         nl,'question form "the attribute of object receives_answer value"',
  49.         nl]),!,fail.
  50. query the Attr of Obj is Value receives_answer Answer :-!,
  51.     write('Is it the case that the '),write(Attr),write(' of '),
  52.     write(Obj),write(' is '),write(Value),write('?'),nl,
  53.     
  54. write('Answer yes/no ==> '),
  55.         'pd624 read'(the Attr of Obj is Value,Answer,X),nl,
  56.     (standardise_answers(X,Answer); /* this will fail is answer is not
  57.                                           yes or no */
  58.     update_answers(the Attr of Obj is Value,X),fail),
  59.     consistency_check(Obj,Attr,Value,Answer),
  60.     update_answers(the Attr of Obj is Value, Answer).
  61. query the Attr of Obj receives_answer Value :- !,
  62.     write('What is the '),write(Attr),write(' of '),
  63.         write(Obj),nl,write('==> '),'pd624 read'(the Attr of Obj,Value,Value1),
  64.     Value = Value1,
  65.            store(Obj,Attr,Value),
  66.     update_answers(the Attr of Obj, Value).
  67.  
  68. query  [H|T] receives_answer Whatever :- !,
  69.     'pd624 pretty list'([H|T]),nl,
  70.     yes_no_check([H|T],Whatever).
  71. query Thing receives_answer Whatever :-
  72.     write(Thing),nl,
  73.     yes_no_check(Thing,Whatever).
  74.  
  75. yes_no_check(Thing,Answer):- (var(Answer); \+(Answer=yes),
  76.         \+(Answer=no)),!, /* next two clauses thus disallowed */
  77.     write(' ==> '),
  78.     'pd624 read'(Thing,Answer,Answer),nl,
  79.     update_answers(Thing,Answer).
  80.     
  81. yes_no_check(Thing,yes):- !,
  82.     write('Answer yes/no ==> '),'pd624 read'(Thing,yes,X),nl,
  83.     (standardise_answers(X,yes);
  84.     update_answers(Thing,X),fail),
  85.     chuck_it_out(Thing),
  86.     assert(currentdb(Thing,true)),
  87.     update_answers(Thing, yes).
  88.  
  89. yes_no_check(Thing,no):- !,
  90.     write('Answer yes./no. ==> '),'pd624 read'(Thing,no,X),nl,
  91.     (standardise_answers(X,no);
  92.     update_answers(Thing,X),fail),
  93.     assert(currentdb(Thing,false)),
  94.     chuck_it_out(Thing),
  95.     update_answers(Thing,no).
  96.  
  97. 'pd624 read'(Thing,Input,Answer):-
  98.     
  99.         repeat_and_prompt,
  100.         read(X),
  101.     completion(Thing,Input,Answer,X),!.
  102.  
  103. repeat_and_prompt.
  104. repeat_and_prompt:- nl, write('==> '), repeat_and_prompt.
  105.  
  106. completion(Thing,Input,Answer,why):-
  107.     Thing explained_by Text,
  108.     'pd624 write'(Text),nl,!,fail.
  109. completion(Thing,Input,Answer,why):-
  110.     write('Currently MIKE has no explanation.'),nl,!,fail.
  111. completion(Thing,Input,Answer,how(Item)):-
  112.  nonvar(Item),
  113.     how Item,nl,!,fail.
  114. completion(Thing,Input,Answer,how(_)):-
  115.     write('MIKE is unable to justify the statement.'),nl,!,fail.
  116. completion(Thing,Input,Answer,halt):- !,
  117.     assert(currentdb(halt,true)).
  118. completion(Thing,Input,Input,Input).
  119. /* yes/no handling is special... user MUST type one of: [yes,y,no,n]
  120.   or the system will complain.  query does the smart thing, i.e. if
  121.   you answer any of the 4 legal choices, your response is asserted in
  122.   the database (under 'receives_answer/2') to avoid asking dumb question
  123.   more than once
  124. */
  125.  
  126. completion(Thing,yes,no,no).
  127. completion(Thing,no,yes,yes).
  128. completion(Thing,yes,yes,y).
  129. completion(Thing,no,no,n).
  130. /* next line means: 'For query Thing, you expected a 'yes', but
  131.    you treat it as a 'no' because the user typed in 'n'. */
  132. completion(Thing,yes,no,n).
  133. completion(Thing,no,yes,y).
  134. completion(Thing,Input,X,Y):-
  135.  (Input = yes;Input = no), 'pd624 write'(
  136.    ['ERROR: ',Y,' is an illegal response.',nl,
  137.    'Answer yes. or no. ',nl]),!,fail.
  138. completion(Thing,Input,X,X):- !.
  139.  
  140.     
  141. update_answers(the A of B,Answer):- \+(B = (C is D)),  /* loop detector */
  142.     update_answers(the A of B is Answer,yes).
  143. update_answers(Thing,Answer):-
  144.     Thing receives_answer Answer1,
  145.     \+ Answer1 = Answer, !,
  146.     write('Warning overwriting existing answer'),nl,write(Thing),
  147.     write(' receives_answer '),write(Answer1),write(' with '),
  148.     nl,write(Thing),write(' receives_answer '),write(Answer),nl,
  149.     retract(Thing receives_answer Answer1),
  150.     assert(Thing receives_answer Answer).
  151. update_answers(T,A):- T receives_answer A,!.
  152. update_answers(T,A):-
  153.     assert(T receives_answer A), !.
  154.  
  155. how Thing:-     justification(Thing,Rule,Conditions),
  156.     write(Thing),write(' was concluded from '),write(Rule),nl,
  157.     write('with the following premises '),nl,tab11_write(Conditions),nl.
  158.  
  159. why X:-
  160.         X explained_by Text,
  161.         'pd624 write'(Text).
  162.  
  163. chuck_it_out(Thing):-
  164.     retract(currentdb(Thing,Truth)).
  165. chuck_it_out(_). /* or rather not in this case! */
  166.  
  167. consistency_check(Obj,Attr,Value,no). /* don't record something that's not
  168.                     the case */
  169. consistency_check(Obj,Attr,Value,Answer):-
  170.     fetch(Obj,Attr,Value1,[Obj],_),
  171.     (Value1 = Value;
  172.     writel(['Warning: in the knowledge-base is the information that',
  173.         Attr,' of ',Obj,' is ',Value1,nl,
  174.         'However this is going to be overwritten by the following',nl,
  175.                 Attr,' of ',Obj,' is ',Value,nl]),
  176.         store(Obj,Attr,Value)).
  177. consistency_check(A,B,C,_):-store(A,B,C).
  178.  
  179. /* positive answers and translation */
  180. standardise_answers(yes,yes).
  181. standardise_answers(y,yes).
  182. standardise_answers(ok,yes).
  183. standardise_answers(true,yes).
  184. standardise_answers(ye,yes).  /* fake escape recognition!!! */
  185.  
  186. /* negative answers and their translation */
  187. standardise_answers(no,no).
  188. standardise_answers(n,no).
  189. standardise_answers(false,no).
  190.  
  191.  
  192. /* enforce unbound answers to right-hand-side queries */
  193. answer_vetting(C):-
  194.                    var(C),!.
  195. answer_vetting(_):-
  196.   'pd624 write'(['Warning : you should not specify answers to forward',nl,
  197.    'chaining queries.',nl]),!.  /* the cut protects 'pd624 write'!!!! */
  198.